home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / lib_core.tcl < prev    next >
Encoding:
Text File  |  1997-09-02  |  18.8 KB  |  610 lines

  1. ##############################################################################
  2. # $Id: lib_core.tcl,v 1.10 1997/09/03 04:54:03 stewart Exp $
  3. #
  4. # lib_core.tcl - core tcl/tk widget support library
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. #
  23. # initializes this library
  24. #
  25. proc vTcl:widget:lib:lib_core {args} {
  26.     global vTcl
  27.     foreach i {toplevel frame button entry label text listbox menubutton \
  28.                checkbutton radiobutton scrollbar_v scrollbar_h scale_h \
  29.                scale_v canvas menu message} {
  30.         image create photo "ctl_$i" \
  31.             -file [file join $vTcl(VTCL_HOME) images icon_$i.gif]
  32.         image create photo "ctl_$i" \
  33.             -file [file join $vTcl(VTCL_HOME) images icon_$i.gif]
  34.     }
  35.     foreach i {toplevel message frame canvas button entry label text \
  36.                listbox menubutton checkbutton radiobutton scrollbar \
  37.                scale} {
  38.         if {$i == "scale" || $i == "scrollbar"} {
  39.             vTcl:toolbar_add $i "horizontal ${i}" ctl_${i}_h "-orient horiz"
  40.             vTcl:toolbar_add $i "vertical ${i}" ctl_${i}_v "-orient vert"
  41.         } else {
  42.             vTcl:toolbar_add $i $i ctl_$i ""
  43.         }
  44.     }
  45. }
  46.  
  47. #
  48. # Set additional attributes to set on widget-class insertion
  49. #
  50. set vTcl(button,insert)       "-text button"
  51. set vTcl(canvas,insert)       "-bd 2 -relief ridge"
  52. set vTcl(checkbutton,insert)  "-text check"
  53. set vTcl(entry,insert)        ""
  54. set vTcl(frame,insert)        "-bd 2 -relief groove -width 125 -height 75"
  55. set vTcl(label,insert)        "-text label -bd 1 -relief raised"
  56. set vTcl(listbox,insert)      ""
  57. set vTcl(menubutton,insert)   "-text menu"
  58. set vTcl(message,insert)      "-text message"
  59. set vTcl(radiobutton,insert)  "-text radio"
  60. set vTcl(scale,insert)        ""
  61. set vTcl(scrollbar,insert)    ""
  62. set vTcl(text,insert)         ""
  63. set vTcl(toplevel,insert)     ""
  64.  
  65. #
  66. # add to valid class list
  67. #
  68. lappend vTcl(classes) Button Canvas Checkbutton Entry Frame Label
  69. lappend vTcl(classes) Listbox Menu Menubutton Message Radiobutton
  70. lappend vTcl(classes) Scale Scrollbar Text Toplevel 
  71.  
  72. foreach c {Button Canvas Checkbutton Entry Frame Label
  73.            Listbox Menu Menubutton Message Radiobutton
  74.            Scale Scrollbar Text Toplevel} {
  75.     # option dump procedure for a widget class
  76.     set vTcl($c,dump_opt) vTcl:dump_widget_opt
  77.     # whether or not to dump children of a class
  78.     set vTcl($c,dump_children) 1
  79. }
  80.  
  81. #
  82. # individual widget commands executed after insert
  83. #
  84. proc vTcl:widget:entry:inscmd {target} {
  85.     return "$target insert end entry"
  86. }
  87.  
  88. proc vTcl:widget:listbox:inscmd {target} {
  89.     return "$target insert end listbox"
  90. }
  91.  
  92. proc vTcl:widget:menubutton:inscmd {target} {
  93.     return "
  94.         menu $target.m
  95.         $target conf -menu $target.m
  96.     "
  97. }
  98.  
  99. proc vTcl:widget:text:inscmd {target} {
  100.     return "$target insert end text"
  101. }
  102.  
  103. proc vTcl:widget:toplevel:inscmd {target} {
  104.     global vTcl
  105.     return "
  106.         wm protocol $target WM_DELETE_WINDOW {vTcl:hide_top $target} 
  107.         if {$vTcl(pr,winfocus) == 1} {
  108.             wm protocol $target WM_TAKE_FOCUS {vTcl:wm_take_focus $target} 
  109.         }
  110.         wm title $target \"New Toplevel $vTcl(newtops)\"
  111.         incr vTcl(newtops)
  112.         set vTcl(w,insert) $target
  113.         lappend vTcl(tops) $target
  114.         vTcl:update_top_list
  115.     "
  116. }
  117.  
  118. #
  119. # per-widget action to take upon edit-mode double-click
  120. #
  121. proc vTcl:widget:entry:dblclick {target} {
  122.     vTcl:set_textvar $target
  123. }
  124.  
  125. proc vTcl:widget:message:dblclick {target} {
  126.     vTcl:set_label $target
  127. }
  128.  
  129. proc vTcl:widget:label:dblclick {target} {
  130.     vTcl:set_label $target
  131. }
  132.  
  133. proc vTcl:widget:button:dblclick {target} {
  134.     vTcl:set_command $target
  135. }
  136.  
  137. proc vTcl:widget:checkbutton:dblclick {target} {
  138.     vTcl:set_command $target
  139. }
  140.  
  141. proc vTcl:widget:radiobutton:dblclick {target} {
  142.     vTcl:set_command $target
  143. }
  144.  
  145. proc vTcl:widget:scale:dblclick {target} {
  146.     vTcl:set_command $target
  147. }
  148.  
  149. proc vTcl:widget:scrollbar:dblclick {target} {
  150.     vTcl:set_command $target
  151. }
  152.  
  153. proc vTcl:widget:menubutton:dblclick {target} {
  154.     vTcl:edit_target_menu $target
  155. }
  156.  
  157. proc vTcl:widget:toplevel:dblclick {target} {
  158.     vTcl:edit_target_menu $target
  159. }
  160.  
  161. ####################################################################
  162. # Procedure to support extra geometry mgr configuration
  163. #
  164.  
  165. proc vTcl:grid:conf_ext {target var value} {
  166.     global vTcl
  167.     set parent [winfo parent $target]
  168.     grid columnconf $parent $vTcl(w,grid,-column) -weight  $vTcl(w,grid,column,weight)
  169.     grid columnconf $parent $vTcl(w,grid,-column) -minsize $vTcl(w,grid,column,minsize)
  170.     grid rowconf    $parent $vTcl(w,grid,-row)    -weight  $vTcl(w,grid,row,weight)
  171.     grid rowconf    $parent $vTcl(w,grid,-row)    -minsize $vTcl(w,grid,row,minsize)
  172. }
  173.  
  174. proc vTcl:wm:conf_geom {target var value} {
  175.     global vTcl
  176.     set x $vTcl(w,wm,geometry,x)
  177.     set y $vTcl(w,wm,geometry,y)
  178.     set w $vTcl(w,wm,geometry,w)
  179.     set h $vTcl(w,wm,geometry,h)
  180.     wm geometry $target ${w}x${h}+${x}+${y}
  181. }
  182.  
  183. proc vTcl:wm:conf_resize {target var value} {
  184.     global vTcl
  185.     set w $vTcl(w,wm,resizable,w)
  186.     set h $vTcl(w,wm,resizable,h)
  187.     wm resizable $target $w $h
  188. }
  189.  
  190. proc vTcl:wm:conf_minmax {target var value} {
  191.     global vTcl
  192.     set min_x $vTcl(w,wm,minsize,x)
  193.     set min_y $vTcl(w,wm,minsize,y)
  194.     set max_x $vTcl(w,wm,maxsize,x)
  195.     set max_y $vTcl(w,wm,maxsize,y)
  196.     wm minsize $target $min_x $min_y
  197.     wm maxsize $target $max_x $max_y
  198. }
  199.  
  200. proc vTcl:wm:conf_state {target var value} {
  201.     global vTcl
  202.     wm $vTcl(w,wm,state) $target
  203. }
  204.  
  205. proc vTcl:wm:conf_title {target var value} {
  206.     global vTcl
  207.     wm title $target "$vTcl(w,wm,title)"
  208. }
  209.  
  210. ####################################################################
  211. # Procedures to support "double-click" action on widets
  212. # There are mostly procedures to support the special case of menus
  213. #
  214.  
  215. proc vTcl:menu_item_add {base target} {
  216. global vTcl
  217.     set type $vTcl(menu,$target,type)
  218.     set label $vTcl(menu,$target,label)
  219.     set accel $vTcl(menu,$target,accel)
  220.     if {$label == ""} {
  221.         set label $type
  222.     }
  223.     switch $type {
  224.         separator {
  225.             $target add $type
  226.         }
  227.         command -
  228.         checkbutton -
  229.         radiobutton {
  230.             $target add $type -label $label -accel $accel
  231.         }
  232.         cascade {
  233.             set nmenu [vTcl:new_widget_name menu $target]
  234.             menu $nmenu
  235.             vTcl:setup_vTcl:bind $nmenu
  236.             $target add $type -label $label -accel $accel -menu $nmenu
  237.         }
  238.     }
  239.     set list $base.fra19.lis35
  240.     switch $type {
  241.         separator {
  242.             $list insert end [format "%-14s" <$type>]
  243.         }
  244.         default {
  245.             $list insert end [format "%-14s %s" <$type> $label]
  246.         }
  247.     }
  248.     set vTcl(menu,$target,label) ""
  249.     set vTcl(menu,$target,accel) ""
  250.     focus $base.fra17.ent15
  251. }
  252.  
  253. proc vTcl:menu_item_update {base target {newpos 0}} {
  254. global vTcl
  255.     set list $base.fra19.lis35
  256.     set num [$list curselection]
  257.     if {"$num" == ""} {return}
  258.     set type $vTcl(menu,$target,type)
  259.     if {[$target type $num] == "tearoff"} {
  260.         vTcl:dialog "You cannot update a cascade."
  261.         return
  262.     }
  263.     if {[$target cget -tearoff]} {
  264.         set min 1
  265.     } else {
  266.         set min 0
  267.     }
  268.     set max [expr [$list size] -1]
  269.     set newnum [expr $num + $newpos]
  270.     if {$newnum < $min || $newnum > $max} {return}
  271.     if {$newpos == 0} {
  272.         set label $vTcl(menu,$target,label)
  273.         set accel $vTcl(menu,$target,accel)
  274.     } else {
  275.         set label [$target entrycget $num -label]
  276.         set accel [$target entrycget $num -accel]
  277.     }
  278.     $list delete $num
  279.     switch $type {
  280.         separator {
  281.             $list insert $newnum [format "%-14s" <$type>]
  282.         }
  283.         default {
  284.             $list insert $newnum [format "%-14s %s" <$type> $label]
  285.         }
  286.     }
  287.     if [catch {set cmd [$target entrycget $num -command]}] {
  288.         set cmd ""
  289.     }
  290.     catch {set cur_menu [$target entrycget $num -menu]}
  291.     $target delete $num
  292.     switch $type {
  293.         separator {
  294.             $target insert $newnum $type
  295.         }
  296.         cascade {
  297.             $target insert $newnum $type -label $label \
  298.                 -accel $accel -command $cmd -menu $cur_menu
  299.         }
  300.         default {
  301.             $target insert $newnum $type -label $label \
  302.                 -accel $accel -command $cmd
  303.         }
  304.     }
  305.     set vTcl(menu,$target,label) ""
  306.     set vTcl(menu,$target,accel) ""
  307.     $list select set $newnum
  308.     focus $base.fra17.ent15
  309. }
  310.  
  311. proc vTcl:menu_item_delete {base target} {
  312. global vTcl
  313.     set list $base.fra19.lis35
  314.     set num [$list curselection]
  315.     if {"$num" == ""} {return}
  316.     set type [$target type $num]
  317.     if {$type == "tearoff"} {
  318.         vTcl:dialog "You cannot delete a $type.\nPlease use tearoff toggle."
  319.         return
  320.     }
  321.     if {$type == "cascade"} {
  322.         set menu [$target entrycget $num -menu]
  323.         destroy $menu
  324.     }
  325.     $target delete $num
  326.     $list delete $num
  327.     set vTcl(menu,$target,label) ""
  328.     set vTcl(menu,$target,accel) ""
  329. }
  330.  
  331. proc vTcl:menu_set_tear {base target} {
  332.     global vTcl
  333.     $target conf -tearoff $vTcl(menu,$target,tear)
  334.     vTcl:menu_setup $base $target
  335. }
  336.  
  337. proc vTcl:menu_setup {base target} {
  338. global vTcl
  339.     set vTcl(menu,$target,name) $target
  340.     set vTcl(menu,$target,type) "command"
  341.     set vTcl(menu,$target,label) ""
  342.     set vTcl(menu,$target,accel) ""
  343.     set vTcl(menu,$target,tear) [$target cget -tearoff]
  344.     set list $base.fra19.lis35
  345.     $list delete 0 end
  346.     set num [$target index end]
  347.     if {$num != "none"} {
  348.         for {set i 0} {$i <= $num} {incr i} {
  349.             if [catch {set label [$target entrycget $i -label]}] {
  350.                 set label ""
  351.             }
  352.             set type [$target type $i]
  353.             $list insert end [format "%-14s %s" <$type> $label]
  354.         }
  355.     }
  356. }
  357.  
  358. proc vTcl:menu_item_get_cmd {target num} {
  359.     global vTcl
  360.     set base ".vTcl.com_[vTcl:rename $target]_$num"
  361.     set cmd [$target entrycget $num -command]
  362.     set lbl [$target entrycget $num -label]
  363.     set r [vTcl:get_command "Command for $lbl ($target)" $cmd $base]
  364.     if {$r == -1} {
  365.         return
  366.     } else {
  367.         $target entryconf $num -command [string trim $r]
  368.     }
  369. }
  370.  
  371. proc vTcl:menu_item_act {base target} {
  372. global vTcl
  373.     set list $base.fra19.lis35
  374.     set num [$list curselection]
  375.     if {"$num" == ""} {return}
  376.     set type [$target type $num]
  377.     switch $type {
  378.         cascade {
  379.             vTcl:edit_menu [$target entrycget $num -menu]
  380.         }
  381.         command -
  382.         checkbutton -
  383.         radiobutton {
  384.             vTcl:menu_item_get_cmd $target $num
  385.         }
  386.     }
  387. }
  388.  
  389. proc vTcl:menu_item_select {base target} {
  390. global vTcl
  391.     set list $base.fra19.lis35
  392.     set num [$list curselection]
  393.     if {"$num" == ""} {return}
  394.     set type [$target type $num]
  395.     set vTcl(menu,$target,type) $type
  396.     switch $type {
  397.         cascade -
  398.         command -
  399.         checkbutton -
  400.         radiobutton {
  401.             set vTcl(menu,$target,label) [$target entrycget $num -label]
  402.             set vTcl(menu,$target,accel) [$target entrycget $num -accel]
  403.         }
  404.         separator {
  405.             set vTcl(menu,$target,type)  "$type"
  406.             set vTcl(menu,$target,label) ""
  407.             set vTcl(menu,$target,accel) ""
  408.         }
  409.         tearoff {
  410.             set vTcl(menu,$target,type)  "command"
  411.             set vTcl(menu,$target,label) ""
  412.             set vTcl(menu,$target,accel) ""
  413.         }
  414.     }
  415. }
  416.  
  417. proc vTcl:edit_target_menu {target} {
  418.     global vTcl
  419.     if [catch {set menu [$target cget -menu]}] {
  420.         return
  421.     }
  422.     if {$menu == ""} {
  423.         set menu [vTcl:new_widget_name m $target]
  424.         menu $menu
  425.         vTcl:setup_vTcl:bind $menu
  426.         $target conf -menu $menu
  427.     }
  428.     vTcl:edit_menu $menu
  429. }
  430.  
  431. proc vTcl:edit_menu {target} {
  432.     global vTcl
  433.     if {$target == ""} {return}
  434.     vTcl:active_widget $target
  435.     if {[winfo class $target] != "Menu"} {return}
  436.     set name [vTcl:rename $target]
  437.     set base ".vTcl.menu_$name"
  438.     if {[winfo exists $base]} "
  439.         wm deiconify $base; return
  440.     "
  441.     set vTcl(menu,$target,tear) 0
  442.     set vTcl(menu,$target,name) ""
  443.     set vTcl(menu,$target,type) ""
  444.     set vTcl(menu,$target,label) ""
  445.     set vTcl(menu,$target,accel) ""
  446.     toplevel $base -class vTcl
  447.     wm focusmodel $base passive
  448.     wm geometry $base 255x280+221+168
  449.     wm maxsize $base 1137 870
  450.     wm minsize $base 1 280
  451.     wm overrideredirect $base 0
  452.     wm resizable $base 0 1
  453.     wm deiconify $base
  454.     wm title $base "Editing Menu"
  455.     frame $base.fra16 \
  456.         -borderwidth 2 -height 30 -relief groove -width 30 
  457.     pack $base.fra16 \
  458.         -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  459.         -side top 
  460.     label $base.fra16.lab20 \
  461.         -anchor w  \
  462.         -relief groove -text Menu -width 7 
  463.     pack $base.fra16.lab20 \
  464.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  465.         -side left 
  466.     entry $base.fra16.ent21 \
  467.         -highlightthickness 0 -textvariable vTcl(menu,$target,name) \
  468.         -width 14 
  469.     pack $base.fra16.ent21 \
  470.         -anchor center -expand 1 -fill x -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  471.         -side left 
  472.     frame $base.fra3 \
  473.         -borderwidth 1 -height 30 -relief sunken -width 30 
  474.     pack $base.fra3 \
  475.         -anchor center -expand 0 -fill both -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  476.         -side top 
  477.     checkbutton $base.fra3.che4 \
  478.         -borderwidth 1 \
  479.         -command "
  480.             vTcl:menu_set_tear $base $target
  481.         " \
  482.         -highlightthickness 0 -indicatoron 0 -text {Tearoff Menu} \
  483.         -variable vTcl(menu,$target,tear) -selectcolor #ed7291
  484.     pack $base.fra3.che4 \
  485.         -anchor center -expand 0 -fill both -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  486.         -side top 
  487.     frame $base.fra17 \
  488.         -borderwidth 1 -height 70 -relief sunken -width 30 
  489.     pack $base.fra17 \
  490.         -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  491.         -side top 
  492.     label $base.fra17.lab11 \
  493.         -anchor w  \
  494.         -relief groove -text {Entry Type} 
  495.     place $base.fra17.lab11 \
  496.         -x 5 -relx 0 -y 5 -rely 0 -width 75 -height 20 -anchor nw \
  497.         -bordermode ignore 
  498.     label $base.fra17.lab12 \
  499.         -anchor w  \
  500.         -relief groove -text Accelerator 
  501.     place $base.fra17.lab12 \
  502.         -x 5 -relx 0 -y 45 -rely 0 -width 75 -height 20 -anchor nw \
  503.         -bordermode ignore 
  504.     label $base.fra17.lab13 \
  505.         -anchor w  \
  506.         -relief groove -text {Entry Label} 
  507.     place $base.fra17.lab13 \
  508.         -x 5 -relx 0 -y 25 -rely 0 -width 75 -height 20 -anchor nw \
  509.         -bordermode ignore 
  510.     entry $base.fra17.ent15 \
  511.         -highlightthickness 0 -textvariable vTcl(menu,$target,label) 
  512.     place $base.fra17.ent15 \
  513.         -x 85 -relx 0 -y 25 -rely 0 -width 161 -height 19 -anchor nw \
  514.         -bordermode ignore 
  515.     entry $base.fra17.ent16 \
  516.         -highlightthickness 0 -textvariable vTcl(menu,$target,accel) 
  517.     bind $base.fra17.ent16 <Return> "
  518.         vTcl:menu_item_add $base $target
  519.     "
  520.     place $base.fra17.ent16 \
  521.         -x 85 -relx 0 -y 45 -rely 0 -width 161 -height 19 -anchor nw \
  522.         -bordermode ignore 
  523.     menubutton $base.fra17.men17 \
  524.         -borderwidth 1 \
  525.         -menu $base.fra17.men17.m -padx 5 -pady 4 -relief raised \
  526.         -textvariable vTcl(menu,$target,type) 
  527.     place $base.fra17.men17 \
  528.         -x 85 -relx 0 -y 5 -rely 0 -width 160 -height 19 -anchor nw \
  529.         -bordermode ignore 
  530.     menu $base.fra17.men17.m \
  531.          -tearoff 0 
  532.     $base.fra17.men17.m add command \
  533.         -command "set vTcl(menu,$target,type) cascade" \
  534.         -label cascade 
  535.     $base.fra17.men17.m add command \
  536.         -command "set vTcl(menu,$target,type) command" \
  537.         -label command 
  538.     $base.fra17.men17.m add command \
  539.         -command "set vTcl(menu,$target,type) checkbutton" \
  540.         -label checkbutton 
  541.     $base.fra17.men17.m add command \
  542.         -command "set vTcl(menu,$target,type) radiobutton" \
  543.         -label radiobutton 
  544.     $base.fra17.men17.m add command \
  545.         -command "set vTcl(menu,$target,type) separator" \
  546.         -label separator 
  547.     frame $base.fra19 \
  548.         -height 30 -width 30 
  549.     pack $base.fra19 \
  550.         -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  551.         -side top 
  552.     listbox $base.fra19.lis35 \
  553.          -height 5 \
  554.         -highlightthickness 0 -yscrollcommand "$base.fra19.scr36 set" \
  555.         -exportselection 0
  556.     pack $base.fra19.lis35 \
  557.         -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 -padx 0 -pady 0 \
  558.         -side left 
  559.     vTcl:set_balloon $base.fra19.lis35 "Double-Click to edit"
  560.     bind $base.fra19.lis35 <Double-Button-1> "
  561.         vTcl:menu_item_act $base $target
  562.     "
  563.     bind $base.fra19.lis35 <ButtonRelease-1> "
  564.         vTcl:menu_item_select $base $target
  565.     "
  566.     bind $base <Down> "
  567.         vTcl:menu_item_update $base $target 1
  568.     "
  569.     bind $base <Up> "
  570.         vTcl:menu_item_update $base $target -1
  571.     "
  572.     scrollbar $base.fra19.scr36 \
  573.         -borderwidth 1 -command "$base.fra19.lis35 yview" \
  574.         -highlightthickness 0 -width 10 
  575.     pack $base.fra19.scr36 \
  576.         -anchor center -expand 0 -fill y -ipadx 0 -ipady 0 -padx 0 -pady 0 \
  577.         -side right 
  578.     frame $base.fra2 \
  579.         -borderwidth 1 -height 30 -relief sunken -width 30 
  580.     pack $base.fra2 \
  581.         -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  582.         -side top 
  583.     button $base.fra2.01 \
  584.         -command "vTcl:menu_item_add $base $target" \
  585.         -highlightthickness 0 -padx 11 -pady 3 -text Add -width 4 
  586.     pack $base.fra2.01 \
  587.         -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  588.         -side left 
  589.     button $base.fra2.02 \
  590.         -command "vTcl:menu_item_update $base $target" \
  591.         -highlightthickness 0 -padx 11 -pady 3 -text Update -width 4 
  592.     pack $base.fra2.02 \
  593.         -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  594.         -side left 
  595.     button $base.fra2.03 \
  596.         -command "vTcl:menu_item_delete $base $target" \
  597.         -highlightthickness 0 -padx 11 -pady 3 -text Delete -width 4 
  598.     pack $base.fra2.03 \
  599.         -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  600.         -side left 
  601.     button $base.fra2.04 \
  602.         -command "destroy $base" \
  603.         -highlightthickness 0 -padx 11 -pady 3 -text Done -width 4 
  604.     pack $base.fra2.04 \
  605.         -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  606.         -side left 
  607.     vTcl:menu_setup $base $target
  608. }
  609.  
  610.